home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
DefProcs
/
SICN Cntl
/
SICN CDEF.p
< prev
next >
Wrap
Text File
|
1992-07-31
|
11KB
|
346 lines
unit SICN_CDEF;
{David B. Lamkins, June 1991}
{}
{Revision History:}
{ DBL, 2 March 1992 — Provided correct control value behavior for all variants.}
{ DBL, 20 July 1992 — Initialized contrlMin and contrlMax so SetCtlValue will work.}
{This is a CDEF for a small–icon (SICN) button that provides the following features:}
{ • Uses control title, rather than a separate dialog item or control title.}
{ • Handles “showTitle” variant (CDEF ID*16+1) to display control title centered under icon.}
{ • Handles “useWFont” variant (CDEF ID*16+8) to display title using window font.}
{ • Recognizes HiliteControl to enable/disable button.}
{ • Displays 16x16, 16x32 (CDEF ID*16+4), and 32x16 (CDEF ID*16+6) controls.}
{ • Automatically increments or decrements control value for double-SICN controls.}
{ • Automatically cycles control value for single–SICN controls.}
{}
{Use:}
{ CNTL min = SICN resource ID.}
{ CNTL title = title to display for showTitle variant.}
{ CNTL proc ID = 112, 113, 116, 117, 118, 119, 120, 121, 124, 125, 126, or 127 (since this is CDEF 7).}
{ CNTL max and refcon are unused.}
{ DITL rect must be at least as large as CNTL rect, otherwise Dialog Mgr won't detect hit in control.}
{ You can not use SetCtlMin to change the icons or increment on the fly…}
{ Calling SetCtlValue changes the displayed icon(s).}
{ If the dialog contains TE fields, “useWFont” requires special handling. The following is}
{ derived from Apple's Q&A Stack:}
{ theDialog := GetNewDialog(…);}
{ SetPort(theDialog);}
{ TextFont(…);}
{ TextSize(…);}
{ ShowWindow(theDialog);}
{ for i := 1 to 3 do}
{ if EventAvail(everyEvent, evt) then}
{ ;}
{ with DialogPeek(theDialog)^.textH^^ do}
{ begin}
{ txFont := theDialog^.txFont;}
{ txSize := theDialog^.txSize;}
{ end;}
{ InitCursor;}
{ repeat}
{ ModalDialog(…);}
{ …}
{ until …;}
{ DisposDialog(theDialog);}
interface
function main (varCode: Integer; theControl: ControlHandle; message: Integer; param: Longint): Longint;
implementation
{$SETC Debugging=False}
function main;
const
calcCntlRgn = 10; {new in System 6.x and 7.0}
calcThumbRgn = 11; {new in System 6.x and 7.0}
titleInset = 1;
SICNlength = 32;
doubleIcon = 4; {variant code}
horizDouble = 2;
showTitle = 1;
upPartCode = 1; {our part codes}
dnPartCode = 2;
horizDoubleIcon = doubleIcon + horizDouble;
type
PrivateData = record
ourSICN: Handle; {the SICN}
maxValue: Integer;
patGrey: Pattern; {our own grey pattern - can't use globals}
ourRgn: RgnHandle; {the control's region for tracking hits}
theIncrement: Integer;
upRect: Rect;
dnRect: Rect;
ourBox: Rect;
end;
DataPtr = ^PrivateData;
DataHandle = ^DataPtr;
var
savePort: GrafPtr; {original port during drawing}
saveFont: Integer; {original font}
saveSize: Integer; {original size}
saveFace: Style; {original style}
centerLine: Integer; {vertical center line of icon}
titleWidth: Integer; {width of the title}
titleRect: Rect; {bounding rect of the title}
textBaseline: Integer; {vertical position of title}
info: FontInfo; {font info for drawing title}
drawValue: Integer; {contrlValue unless maxValue = 0, then 0}
procedure PlotSICN (theSICN: Handle; index: Integer; frame: Rect);
var
theBitmap: BitMap; {bitmap for plotting SICN}
savedState: SignedByte;
ourPort: GrafPtr;
begin
if theSICN <> nil then
begin
savedState := HGetState(theSICN);
HLock(theSICN);
with theBitmap do
begin
baseAddr := Ptr(ORD(theSICN^) + SICNlength * index);
rowBytes := 2;
bounds := frame;
end;
GetPort(ourPort);
CopyBits(theBitmap, ourPort^.portBits, theBitmap.bounds, theBitmap.bounds, srcCopy, nil);
HSetState(theSICN, savedState);
end;
end;
begin {Main — Icon Button CDEF}
main := 0; {we normally return a zero}
HLock(Handle(theControl)); {lock down the control data for the duration}
with theControl^^ do
begin
{----- Initialization -----}
if message = initCntl then
begin
{$IFC Debugging}
DebugStr('initCntl');
{$ENDC}
contrlData := NewHandleClear(SIZEOF(PrivateData)); {allocate private storage}
if contrlData <> nil then
begin
HLock(contrlData);
with DataHandle(contrlData)^^ do
begin {create our local bitmap data}
StuffHex(@patGrey, 'AA55AA55AA55AA55');
ourSICN := GetResource('SICN', contrlMin); {get handle to our SICN}
if ourSICN <> nil then
begin
maxValue := GetHandleSize(ourSICN) div (2 * SICNlength) - 1;
theIncrement := 2;
if BAND(varCode, doubleIcon) <> 0 then
begin
maxValue := maxValue div 2;
theIncrement := theIncrement * 2;
end;
end
else
maxValue := 0;
contrlMin := 0;
contrlMax := maxValue;
ourRgn := NewRgn; {create a region to hold button/title outline}
end;
HUnLock(contrlData);
end;
end
{----- Disposal -----}
else if message = dispCntl then
begin
{$IFC Debugging}
DebugStr('dispCntl');
{$ENDC}
{Don't know who else might be using our SICNs, so leave them alone.}
if contrlData <> nil then
begin
DisposeRgn(DataHandle(contrlData)^^.ourRgn); {done forever with this region}
DisposHandle(contrlData); {don't need our local data anymore, either}
end;
end
else if contrlData <> nil then
begin
HLock(contrlData); {lock down control's private data}
with DataHandle(contrlData)^^ do
case message of
{----- Drawing -----}
drawCntl:
begin
{$IFC Debugging}
DebugStr('drawCntl');
{$ENDC}
GetPort(savePort); {make sure we have the right port}
SetPort(contrlOwner);
with contrlOwner^ do {remember the original font}
begin
saveFont := txFont;
saveSize := txSize;
saveFace := txFace;
end;
if BAND(varCode, useWFont) = 0 then {if we need system font, set it}
begin
TextSize(0);
TextFont(0);
end;
TextFace([]); {make sure we have a clean face}
GetFontInfo(info); {measure the title}
{$PUSH}
{$R-}
titleWidth := TextWidth(@contrlTitle[1], 0, ORD(contrlTitle[0]));
{$POP}
if contrlValue < 0 then {make sure our control value is legitimate}
contrlValue := 0
else if contrlValue > maxValue then
if maxValue > 0 then
contrlValue := maxValue
else
contrlValue := 1;
ourBox := contrlRect;
with ourBox do {force the rect to fit}
case BAND(varCode, doubleIcon + horizDouble) of
0:
begin
bottom := top + 16;
right := left + 16;
centerLine := left + 8;
upRect := ourBox;
SetRect(dnRect, 0, 0, 0, 0);
end;
doubleIcon:
begin
bottom := top + 32;
right := left + 16;
centerLine := left + 8;
upRect := ourBox;
upRect.bottom := top + 16;
dnRect := ourBox;
dnRect.top := upRect.bottom;
end;
horizDoubleIcon:
begin
bottom := top + 16;
right := left + 32;
centerLine := left + 16;
upRect := ourBox;
upRect.left := ourBox.left + 16;
dnRect := ourBox;
dnRect.right := upRect.left;
end;
end;
with info, titleRect do
begin {position the control title and establish its bounding rect}
top := ourBox.bottom;
bottom := top + ascent + descent + leading;
left := centerLine - titleWidth div 2;
right := left + titleWidth;
textBaseline := bottom - descent;
end;
InsetRect(titleRect, -titleInset, 0);
OpenRgn; {make our region include the icon and the label}
FrameRect(ourBox);
if BAND(varCode, showTitle) <> 0 then
FrameRect(titleRect);
CloseRgn(ourRgn); {save the control's region for future reference}
if contrlVis <> 0 then {if the control is visible…}
if ourSICN <> nil then {…and the SICN is present…}
begin {draw the control}
LoadResource(ourSICN);
if BAND(varCode, showTitle) <> 0 then
begin {draw the title}
EraseRect(titleRect);
MoveTo(titleRect.left + titleInset, textBaseline);
DrawString(contrlTitle);
end;
if maxValue > 0 then
drawValue := contrlValue
else
drawValue := 0;
case contrlHilite of
0, 255: {display normal control}
begin
PlotSICN(ourSICN, drawValue * theIncrement, upRect);
PlotSICN(ourSICN, drawValue * theIncrement + 2, dnRect);
end;
1: {display active control — ‘up’ pressed}
begin
PlotSICN(ourSICN, drawValue * theIncrement + 1, upRect);
if maxValue = 0 then
contrlValue := 1
else if (theIncrement = 2) & (maxValue = contrlValue) then
contrlValue := 0
else
contrlValue := contrlValue + 1;
end;
2: {display active control — ‘dn’ pressed}
begin
PlotSICN(ourSICN, drawValue * theIncrement + 3, dnRect);
contrlValue := contrlValue - 1;
end;
end;
if contrlHilite = 255 then
begin {grey out disabled control}
PenPat(patGrey);
PenMode(patBic);
PaintRect(ourBox);
PaintRect(titleRect);
end;
end
else
begin {no icon? draw a blank…}
PenPat(patGrey);
PaintRect(ourBox);
end;
TextFont(saveFont); {set everything back the way it was}
TextSize(saveSize);
TextFace(saveFace);
SetPort(savePort);
end;
{----- Testing -----}
testCntl:
begin
{$IFC Debugging}
DebugStr('testCntl');
{$ENDC}
if (contrlHilite <> 255) then
if PtInRect(Point(param), upRect) then
main := upPartCode
else if PtInRect(Point(param), dnRect) then
main := dnPartCode;
end;
{----- Regions -----}
calcCRgns, calcCntlRgn:
begin
{$IFC Debugging}
DebugStr('calcCRgns, calcCntlRgn');
{$ENDC}
if (message <> calcCRgns) or not BTST(param, 31) then
CopyRgn(ourRgn, RgnHandle(param)); {return control region}
end;
otherwise
; {don't handle other messages}
end;
HUnLock(contrlData);
end;
end;
HUnLock(Handle(theControl));
end;
end.
